SuperHack/SuperHack CD.bin/CODING/DELPHI/D_TAPI.ZIP/CALLFORM.PAS

Pascal/Delphi Source File | 1996-07-01 | 5.6 KB | 215 lines

unit Callform;
{
    *** TAPI Monitor ***
    by Davide Moretti <[e-mail]>

    This is a TAPI Test
    It uses TAPI interface to place outgoing calls.
    You can also monitor these calls with the Monitor...
}

interface

uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    Forms, Dialogs, StdCtrls, Tapi, ExtCtrls;

type
    TfrmTAPICall = class(TForm)
    Label1: TLabel;
        Edit1: TEdit;
        btnCall: TButton;
    Memo1: TMemo;
        btnDropCall: TButton;
    grpMode: TRadioGroup;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnCallClick(Sender: TObject);
    procedure btnDropCallClick(Sender: TObject);
    procedure grpModeClick(Sender: TObject);
    private
        { Private declarations }
        lineApp: THLineApp;
        line: THLine;
        call: THCall;
        CallParams: TlineCallParams;
    public
        { Public declarations }
    end;

var
    frmTAPICall: TfrmTAPICall;

implementation

{$R *.DFM}

uses Main;

var
    buf:array[0..1023] of char;
    callinfo: TLineCallInfo absolute buf;
    {
        these two variables points to the same address.
        since lineGetCallInfo expects a buffer with a TLineCallInfo on top.
    }

{
    TAPI Callback procedure: called for TAPI messages
    you MUST use 'stdcall' since it is called by Windows
}
procedure lineCallback(hDevice, dwMsg, dwCallbackInstance,
        dwParam1, dwParam2, dwParam3: LongInt);
{$IFDEF WIN32}
        stdcall;
{$ELSE}
        export;
{$ENDIF}
    var
        s: string;
        hCall: THCall;
    begin
    if dwMsg = LINE_REPLY then { result of LineMakeCall }
        if dwParam2 < 0 then
            frmTAPICall.Memo1.Lines.Add('Reply error')
        else
            frmTAPICall.Memo1.Lines.Add('LINE_REPLY ok')
    else if dwMsg = LINE_CALLSTATE then    { change in line state }
        begin
        hCall := THCall(hDevice);
        case dwParam1 of
            LINECALLSTATE_IDLE:        { call terminated }
                if hcall <> 0 then
                    begin
                    lineDeallocateCall(hCall);    { you must deallocate the call }
                    frmTAPICall.Memo1.Lines.Add('Idle - call deallocated');
                    frmTAPICall.btnCall.Enabled := True;
                    frmTAPICall.btnDropCall.Enabled := False;
                    end;
            LINECALLSTATE_CONNECTED:    { Service connected }
                if hCall <> 0 then
                    begin
                    s := 'Connected: ';
                    callinfo.dwTotalSize := 1024;
                    if lineGetCallInfo(hCall, callinfo) = 0 then
                        if callinfo.dwAppNameSize > 0 then
{$IFDEF WIN32}
                            s := s + (buf + callinfo.dwAppNameOffset); { this is more C-ish... }
{$ELSE}
                            s := s + StrPas((buf + callinfo.dwAppNameOffset)); { this is more C-ish... }
{$ENDIF}
                    frmTAPICall.Memo1.Lines.Add(s);
                    end;
            LINECALLSTATE_PROCEEDING:        { call proceeding (dialing) }
                frmTAPICall.Memo1.Lines.Add('Proceeding');
            LINECALLSTATE_DIALING:            { dialing }
                frmTAPICall.Memo1.Lines.Add('Dialing');
            LINECALLSTATE_DISCONNECTED:    { disconnected }
                begin
                s := 'Disconnected: ';
                if dwParam2 = LINEDISCONNECTMODE_NORMAL then
                    s := s + 'normal'
                else if dwParam2 = LINEDISCONNECTMODE_BUSY then
                    s := s + 'busy';
                frmTAPICall.Memo1.Lines.Add(s);
                frmTAPICall.btnDropCall.Click;
                end;
            LINECALLSTATE_BUSY: { busy }
                frmTAPICall.Memo1.Lines.Add('Busy');
            end;
        end;
    end;

procedure TfrmTAPICall.FormCreate(Sender: TObject);
    var
        nDevs, tapiVersion: Longint;
        extid: TLineExtensionID;
    begin
    { Initialize TAPI }
    { Zeros CallParams structure }
    FillChar(CallParams, sizeof(CallParams), 0);
    with CallParams do
        begin
        dwTotalSize := sizeof(CallParams);
        dwBearerMode := LINEBEARERMODE_VOICE;
        dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE;
{        dwMediaMode := LINEMEDIAMODE_DATAMODEM;}
        { if you don't want the dialing dialog use LINEMEDIAMODE_DATAMODEM }
        end;
    if lineInitialize(lineApp, HInstance,
            @lineCallback, nil, nDevs) < 0 then        { < 0 is an error }
        lineApp := 0
    else if nDevs = 0 then        { no TAPI devices?? }
        begin
        lineShutDown(lineApp);
        lineApp := 0;
        end
    else if lineNegotiateAPIVersion(lineApp, 0, $00010000, $10000000,
            tapiVersion, extid) < 0 then    { Check for version (copied from a TAPI sample) }
        begin
        lineShutDown(lineApp);
        lineApp := 0;
        end
    { Open a line for outbound calls (here I use first device, normally the modem) }
    else if lineOpen(lineApp, LINEMAPPER, line, tapiVersion, 0, 0,
            LINECALLPRIVILEGE_NONE, 0, CallParams) < 0 then
        begin
        lineShutDown(lineApp);
        lineApp := 0;
        line := 0;
        end;
    if line = 0 then
        Memo1.Lines.Add('Error!!');
    end;

procedure TfrmTAPICall.FormDestroy(Sender: TObject);
    begin
    { Terminate TAPI }
    if line <> 0 then
        lineClose(line);
    if lineApp <> 0 then
        lineShutDown(lineApp);
    frmMain.Call := False;
    end;

procedure TfrmTAPICall.FormClose(Sender: TObject;
        var Action: TCloseAction);
    begin
    Action := caFree;
    end;

procedure TfrmTAPICall.btnCallClick(Sender: TObject);
    var
        c: array[0..30] of char;
    begin
    if Length(Edit1.Text) > 0 then
        begin
        Memo1.Lines.Clear;
        StrPCopy(c, Edit1.Text);
        if lineMakeCall(line, call, c, 0, CallParams) < 0 then
            Memo1.Lines.Add('Error in lineMakeCall')
        else
            begin
            btnCall.Enabled := False;
            btnDropCall.Enabled := True;
            end;
        end;
    end;

procedure TfrmTAPICall.btnDropCallClick(Sender: TObject);
    begin
    if LineDrop(call, nil, 0) < 0 then
        Memo1.Lines.Add('Error in lineDrop')
    end;

procedure TfrmTAPICall.grpModeClick(Sender: TObject);
    begin
    if grpMode.ItemIndex = 0 then
        CallParams.dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE
    else
        CallParams.dwMediaMode := LINEMEDIAMODE_DATAMODEM;
    end;

end.